cDBFSf
cDBFS
2.0Fl
AMERICAN
MODIFY WINDOW SCREEN TITLE "Foxpro for Macintosh" &cFONTS
MODIFY WINDOW SCREEN TITLE "Foxpro for Windows" &cFONTS
DEBUG7@
RUNTIMEFFlj
EXEFFlj
SUSPEND
Data Wire Four 01.02.03
(c) 1993 Dennis Allen
All rights reserved
PROCEDURE 
PARAMETERS cPATH, bBACK
SAVE SCREEN
CLEAR
? "*"
? "* Data Wire Four 01.02.03"
? "* (c) 1993 Dennis Allen"
? "* All rights reserved"
? "*"
? "Please Wait..."
PRIVATE FLD, FLD1, FLD2, bFLAG, cDRIV_SEP, cERROR, cEXACT, cFILE, cPATH_SEP, nCOL, nROW
IF "2.0" $ VERSION()
  STORE .F. TO _MAC, _UNIX, _WINDOWS
  STORE .T. TO _DOS
ENDIF
IF TYPE("cPATH") = "C"
  PRIVATE cDATAPATH
  cDATAPATH = cPATH
ENDIF
cPATH_SEP = "\"
cDRIV_SEP = ":\"
cDATAPATH = FULLPATH(IIF(TYPE("cDATAPATH")<>"C","",ALLTRIM(cDATAPATH)))
IF LEN(cDATAPATH) > 0 .AND. .NOT. RIGHT(cDATAPATH,1) $ cDRIV_SEP
  cDATAPATH=cDATAPATH+cPATH_SEP
ENDIF
IF      ADIR(FLD,ALLTRIM(cDATAPATH)+"*.","D") = 0 ;
  .AND. ADIR(FLD,FULLPATH("")+"*.","D") > 0
  ? "File Path "+cDATAPATH+" does not exist"
  WAIT WINDOW
  IF SYS(16,1) = SYS(16)
    QUIT
  ENDIF
  RETURN
ENDIF
bBACK = IIF(PARAMETERS()>1.AND.TYPE("bBACK")="L",bBACK,.T.)
cFILE = SYS(3)
DO WHILE cFILE = SYS(3)
ENDDO
cERROR = ON("ERROR")
ON ERROR
cEXACT = SET("EXACT")
SET EXACT ON
CLOSE DATABASES
*.DBFa
FOXUSER
*.DBF
SCR.DBF
*.DBF
*.DBF
DO FF
CLOSE DATABASES
ON ERROR 
cERROR
SET EXACT 
cEXACT
? "Verification Complete..."
IF SYS(16,1) = SYS(16)
  WAIT WINDOW
  QUIT
ENDIF
RESTORE SCREEN
RETURN
PROCEDURE FF
? "Verifying 
RELEASE FLD1, FLD2
DIMENSION FLD1(
,4), FLD2(1,4)
mFLDf
FLD1(
STORE .F. TO bFLAG
IF !SYS(2000,cDATAPATH+"
") == ""
  USE (cDATAPATH+"
") ALIAS TEMP
  = AFIELDS(FLD2)
ENDIF
bFLAG = ADJUST(@FLD1, @FLD2)
IF bFLAG
  ? " Updating "+cDATAPATH+"
  USE
  CREATE TABLE (cDATAPATH+cFILE) FROM ARRAY FLD1
  IF !SYS(2000,cDATAPATH+"
") == ""
    APPEND FROM (cDATAPATH+"
    IF bBACK
      DELETE FILE (cDATAPATH+"
      RENAME (cDATAPATH+"
") TO (cDATAPATH+"
    ENDIF
    DELETE FILE (cDATAPATH+"
  ENDIF
  IF !SYS(2000,cDATAPATH+"
") == ""
    IF bBACK
      DELETE FILE (cDATAPATH+"
      RENAME (cDATAPATH+"
") TO (cDATAPATH+"
    ENDIF
    DELETE FILE (cDATAPATH+"
  ENDIF
  DELETE FILE (cDATAPATH+"
  DELETE FILE (cDATAPATH+"
  DELETE FILE (cDATAPATH+"
  USE
  IF !SYS(2000,cDATAPATH+cFILE+".DBF") == ""
    RENAME (cDATAPATH+cFILE+".DBF") TO (cDATAPATH+"
  ENDIF
  IF !SYS(2000,cDATAPATH+cFILE+".FPT") == ""
    RENAME (cDATAPATH+cFILE+".FPT") TO (cDATAPATH+"
  ENDIF
ENDIF
RELEASE FLD
DIMENSION FLD(
mFLDf
IF .NOT. USED("TEMP") .AND. !SYS(2000,cDATAPATH+"
") == ""
  USE (cDATAPATH+"
") ALIAS TEMP
ENDIF
STORE .F. TO bFLAG
FOR nROW = 1 TO 
  IF FLD(nROW,1) <> TAG(nROW) .OR. FLD(nROW,2) <> KEY(nROW) .OR. FLD(nROW,3) <> SYS(2021,nROW)
    STORE .T. TO bFLAG
    EXIT
  ENDIF
ENDFOR
IF bFLAG
  ? " Updating "+cDATAPATH+"
  USE (cDATAPATH+"
") ALIAS TEMP EXCLUSIVE
  DELETE TAG ALL
INDEX ON F
 TAG 
 FOR F
ENDIF
RETURN
FUNCTION ADJUST
PARAMETERS FLD1, FLD2
IF TYPE("FLD2") = "L"
  DIMENSION FLD2(ALEN(FLD1,1),ALEN(FLD1,2))
  = ACOPY(FLD1,FLD2)
  RETURN .T.
ENDIF
PRIVATE bFLAG, nCOL, nDIF, nROW, nROW1, nROW2
FOR nROW = 1 TO ALEN(FLD2,1)
  FLD2(nROW,1) = PADR(FLD2(nROW,1),10)
  nROW1 = ASCAN(FLD1,FLD2(nROW,1))
  nROW1 = IIF(nROW1 <> 0, ASUBSCRIPT(FLD1,nROW1,1),0)
  IF nROW1 = 0
    nROW1 = ALEN(FLD1,1)+1
    DIMENSION FLD1(nROW1,4)
    FOR nCOL = 1 TO 4
      FLD1(nROW1,nCOL) = FLD2(nROW,nCOL)
    ENDFOR
  ENDIF
  IF FLD1(nROW1,2) <> FLD2(nROW,2)
    ? "Warning: "+FLD2(nROW,1)+" has a field type ("+FLD2(nROW,2)+")"
    ? "                  "    +" needs field type ("+FLD1(nROW1,2)+")"
    WAIT WINDOW
    FLD1(nROW1,2) = FLD2(nROW,2)
  ENDIF
  IF FLD1(nROW1,4) < FLD2(nROW,4)
    FLD1(nROW1,4) = FLD2(nROW,4)
  ENDIF
  nDIF = (FLD2(nROW,3) - FLD2(nROW,4)) - (FLD1(nROW1,3) - FLD1(nROW1,4))
  IF nDIF > 0
    FLD1(nROW1,3) = FLD1(nROW1,3) + nDIF
  ENDIF
ENDFOR
STORE .F. TO bFLAG
FOR nROW = 1 TO ALEN(FLD1,1)
  nROW2 = ASCAN(FLD2,FLD1(nROW,1))
  nROW2 = IIF(nROW2 <> 0, ASUBSCRIPT(FLD2,nROW2,1),0)
  IF nROW2 = 0
    STORE .T. TO bFLAG
    EXIT
  ENDIF
  IF FLD2(nROW2,4) < FLD1(nROW,4)
    STORE .T. TO bFLAG
    EXIT
  ENDIF
  nDIF = (FLD1(nROW,3) - FLD1(nROW,4)) - (FLD2(nROW2,3) - FLD2(nROW2,4))
  IF nDIF > 0
    STORE .T. TO bFLAG
    EXIT
  ENDIF
ENDFOR
RETURN bFLAG
*.FXPa
command
CDBFS
   DAMERICAN
 NTMP
   CTEMP
_BROTMP
O FLNTEMP
    CTEMP2
CTEMP3
FLDCTEMP3I
 DCTEMP3N
CTEMP4
TYPCTEMP5
   TEMP
O FLDCROW
    DNROW
 OPT_CCOL
   DOMFLD
 CFLD
 NFLD
ENFLD
ECCOUCTAG
D:\DW4\
DW4.FXP
D:\DW4\DW4.PRG